library(plyr)
library(tidyverse)
Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ──────────────────────────────────────────── tidyverse 1.3.0 ──
✓ ggplot2 3.3.2     ✓ purrr   0.3.4
✓ tibble  3.0.3     ✓ dplyr   1.0.2
✓ tidyr   1.1.2     ✓ stringr 1.4.0
✓ readr   1.4.0     ✓ forcats 0.5.0
── Conflicts ─────────────────────────────────────────────── tidyverse_conflicts() ──
x dplyr::arrange()   masks plyr::arrange()
x purrr::compact()   masks plyr::compact()
x dplyr::count()     masks plyr::count()
x dplyr::failwith()  masks plyr::failwith()
x dplyr::filter()    masks stats::filter()
x dplyr::id()        masks plyr::id()
x dplyr::lag()       masks stats::lag()
x dplyr::mutate()    masks plyr::mutate()
x dplyr::rename()    masks plyr::rename()
x dplyr::summarise() masks plyr::summarise()
x dplyr::summarize() masks plyr::summarize()
library(lubridate)

Attaching package: ‘lubridate’

The following objects are masked from ‘package:base’:

    date, intersect, setdiff, union
library(plotly)
Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 methods overwritten by 'htmltools':
  method               from         
  print.html           tools:rstudio
  print.shiny.tag      tools:rstudio
  print.shiny.tag.list tools:rstudio
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following objects are masked from ‘package:plyr’:

    arrange, mutate, rename, summarise

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout

Data Extraction, Transformation & Loading

#Import the dataset, random select 50,000 rows
original <- read.csv('https://s3.amazonaws.com/nyc-tlc/trip+data/yellow_tripdata_2020-06.csv')
original<-drop_na(original)
unique(original$RatecodeID)
[1]  1  2  3  5  4 99  6
original <- subset.data.frame(original, original$RatecodeID != 99, drop = TRUE)
set.seed(100518243)
index <- sample(1:nrow(original),50000)
june2020 <- (original[index,])
attach(june2020)
dim(june2020)
[1] 50000    18
problems(june2020)

Transform the datetime columns from character to datetime data types

june2020$tpep_pickup_datetime <- ymd_hms(june2020$tpep_pickup_datetime)
june2020$tpep_dropoff_datetime <- ymd_hms(june2020$tpep_dropoff_datetime)

Count the number of null value rows for each column

sapply(june2020, function(y) sum(length(which(is.na(y)))))
             VendorID  tpep_pickup_datetime tpep_dropoff_datetime 
                    0                     0                     0 
      passenger_count         trip_distance            RatecodeID 
                    0                     0                     0 
   store_and_fwd_flag          PULocationID          DOLocationID 
                    0                     0                     0 
         payment_type           fare_amount                 extra 
                    0                     0                     0 
              mta_tax            tip_amount          tolls_amount 
                    0                     0                     0 
improvement_surcharge          total_amount  congestion_surcharge 
                    0                     0                     0 

Convert columns to categorical factors

june2020$store_and_fwd_flag <- parse_factor(june2020$store_and_fwd_flag)
june2020$payment_type <- factor(june2020$payment_type)
june2020$VendorID <- factor(june2020$VendorID)
june2020$payment_type <- mapvalues(payment_type, from = c("1", "2", "3","4","5"), to = c("Credit Card", "Cash","No charge","Dispute","Unknown"))
june2020$VendorID <- mapvalues(VendorID, from = c("1", "2"), to = c("Creative Mobile Technologies", "VeriFone Inc"))
june2020$RatecodeID <- mapvalues(payment_type, from = c("1", "2", "3","4","5"), to = c("Standard Rate", "JFK","Newark","Nassau or Westchester","Negotiated fare"))
june2020$pickup_day <- factor(day(tpep_pickup_datetime))
june2020$pickup_month <- factor(month(tpep_pickup_datetime, label = TRUE))
june2020$pickup_dayofweek <- factor(wday(tpep_pickup_datetime, label = TRUE))

june2020$dropoff_day <- factor(day(tpep_dropoff_datetime))
june2020$dropoff_month <- factor(month(tpep_dropoff_datetime, label = TRUE))
june2020$dropoff_dayofweek <- factor(wday(tpep_dropoff_datetime, label = TRUE))
june2020$pickup_hour <- factor(hour(tpep_pickup_datetime))
june2020$dropoff_hour <- factor(hour(tpep_dropoff_datetime))
str(june2020)
'data.frame':   50000 obs. of  26 variables:
 $ VendorID             : chr  "VeriFone Inc" "Creative Mobile Technologies" "VeriFone Inc" "Creative Mobile Technologies" ...
 $ tpep_pickup_datetime : POSIXct, format: "2020-06-14 14:06:41" "2020-06-30 20:03:34" ...
 $ tpep_dropoff_datetime: POSIXct, format: "2020-06-14 14:12:58" "2020-06-30 20:04:44" ...
 $ passenger_count      : int  1 0 1 1 1 1 2 1 4 1 ...
 $ trip_distance        : num  1.71 0.4 1.82 3.2 3 1.97 1.26 0.87 1.2 1.7 ...
 $ RatecodeID           : chr  "JFK" "JFK" "Standard Rate" "Standard Rate" ...
 $ store_and_fwd_flag   : Factor w/ 2 levels "N","Y": 1 1 1 1 1 1 1 1 1 1 ...
 $ PULocationID         : int  140 140 140 249 43 42 236 239 100 74 ...
 $ DOLocationID         : int  233 263 142 48 161 238 262 143 234 263 ...
 $ payment_type         : chr  "Cash" "Cash" "Credit Card" "Credit Card" ...
 $ fare_amount          : num  8 3.5 9 11 11.5 9.5 7.5 6 6 6.5 ...
 $ extra                : num  0 3 0 3.5 0 0 0 0 2.5 2.5 ...
 $ mta_tax              : num  0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 ...
 $ tip_amount           : num  0 0 1.5 3.05 3.7 0 0 2 1 0 ...
 $ tolls_amount         : num  0 0 0 0 0 0 0 0 0 0 ...
 $ improvement_surcharge: num  0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 ...
 $ total_amount         : num  11.3 7.3 13.8 18.4 18.5 ...
 $ congestion_surcharge : num  2.5 2.5 2.5 2.5 2.5 0 2.5 2.5 2.5 2.5 ...
 $ pickup_day           : Factor w/ 31 levels "1","2","3","4",..: 14 30 26 9 5 12 29 19 16 1 ...
 $ pickup_month         : Ord.factor w/ 3 levels "Jan"<"May"<"Jun": 3 3 3 3 3 3 3 3 3 3 ...
 $ pickup_dayofweek     : Ord.factor w/ 7 levels "Sun"<"Mon"<"Tue"<..: 1 3 6 3 6 6 2 6 3 2 ...
 $ dropoff_day          : Factor w/ 30 levels "1","2","3","4",..: 14 30 26 9 5 12 29 19 16 1 ...
 $ dropoff_month        : Ord.factor w/ 3 levels "Jan"<"Jun"<"Jul": 2 2 2 2 2 2 2 2 2 2 ...
 $ dropoff_dayofweek    : Ord.factor w/ 7 levels "Sun"<"Mon"<"Tue"<..: 1 3 6 3 6 6 2 6 3 2 ...
 $ pickup_hour          : Factor w/ 24 levels "0","1","2","3",..: 15 21 15 18 16 11 16 15 16 13 ...
 $ dropoff_hour         : Factor w/ 24 levels "0","1","2","3",..: 15 21 15 18 16 11 16 15 16 13 ...
summary(june2020)
   VendorID         tpep_pickup_datetime          tpep_dropoff_datetime        
 Length:50000       Min.   :2009-01-01 00:02:59   Min.   :2009-01-01 00:07:40  
 Class :character   1st Qu.:2020-06-10 11:55:41   1st Qu.:2020-06-10 12:05:16  
 Mode  :character   Median :2020-06-18 11:17:42   Median :2020-06-18 11:28:44  
                    Mean   :2020-06-17 12:01:02   Mean   :2020-06-17 12:14:35  
                    3rd Qu.:2020-06-24 23:12:52   3rd Qu.:2020-06-24 23:29:09  
                    Max.   :2020-06-30 23:55:05   Max.   :2020-07-01 13:23:17  
                                                                               
 passenger_count trip_distance      RatecodeID        store_and_fwd_flag
 Min.   :0.000   Min.   :  0.000   Length:50000       N:49594           
 1st Qu.:1.000   1st Qu.:  0.980   Class :character   Y:  406           
 Median :1.000   Median :  1.700   Mode  :character                     
 Mean   :1.357   Mean   :  2.807                                        
 3rd Qu.:1.000   3rd Qu.:  3.130                                        
 Max.   :6.000   Max.   :167.500                                        
                                                                        
  PULocationID    DOLocationID   payment_type        fare_amount     
 Min.   :  1.0   Min.   :  1.0   Length:50000       Min.   :-180.09  
 1st Qu.:107.0   1st Qu.: 90.0   Class :character   1st Qu.:   6.00  
 Median :161.0   Median :157.0   Mode  :character   Median :   8.50  
 Mean   :160.5   Mean   :155.6                      Mean   :  11.81  
 3rd Qu.:234.0   3rd Qu.:234.0                      3rd Qu.:  13.50  
 Max.   :265.0   Max.   :265.0                      Max.   : 509.70  
                                                                     
     extra           mta_tax          tip_amount      tolls_amount    
 Min.   :-4.500   Min.   :-0.5000   Min.   :-36.30   Min.   :-6.1200  
 1st Qu.: 0.000   1st Qu.: 0.5000   1st Qu.:  0.00   1st Qu.: 0.0000  
 Median : 0.500   Median : 0.5000   Median :  1.50   Median : 0.0000  
 Mean   : 1.133   Mean   : 0.4914   Mean   :  1.76   Mean   : 0.2174  
 3rd Qu.: 2.500   3rd Qu.: 0.5000   3rd Qu.:  2.65   3rd Qu.: 0.0000  
 Max.   : 7.000   Max.   : 0.5000   Max.   :104.56   Max.   :69.0000  
                                                                      
 improvement_surcharge  total_amount     congestion_surcharge   pickup_day   
 Min.   :-0.3000       Min.   :-180.39   Min.   :-2.500       26     : 2491  
 1st Qu.: 0.3000       1st Qu.:  10.30   1st Qu.: 2.500       25     : 2380  
 Median : 0.3000       Median :  13.56   Median : 2.500       24     : 2335  
 Mean   : 0.2966       Mean   :  16.98   Mean   : 2.108       29     : 2269  
 3rd Qu.: 0.3000       3rd Qu.:  18.96   3rd Qu.: 2.500       30     : 2261  
 Max.   : 0.3000       Max.   : 627.35   Max.   : 2.500       23     : 2243  
                                                              (Other):36021  
 pickup_month pickup_dayofweek  dropoff_day    dropoff_month dropoff_dayofweek
 Jan:    1    Sun:4475         26     : 2481   Jan:    1     Sun:4496         
 May:    1    Mon:9018         25     : 2382   Jun:49988     Mon:9010         
 Jun:49998    Tue:9216         24     : 2336   Jul:   11     Tue:9197         
              Wed:7097         29     : 2274                 Wed:7115         
              Thu:7192         30     : 2254                 Thu:7195         
              Fri:7759         23     : 2243                 Fri:7750         
              Sat:5243         (Other):36030                 Sat:5237         
  pickup_hour     dropoff_hour  
 14     : 3903   14     : 3855  
 15     : 3891   15     : 3817  
 16     : 3725   16     : 3708  
 13     : 3630   13     : 3636  
 17     : 3594   17     : 3618  
 12     : 3498   12     : 3464  
 (Other):27759   (Other):27902  
glimpse(june2020)
Rows: 50,000
Columns: 26
$ VendorID              <chr> "VeriFone Inc", "Creative Mobile Technologies", "Ver…
$ tpep_pickup_datetime  <dttm> 2020-06-14 14:06:41, 2020-06-30 20:03:34, 2020-06-2…
$ tpep_dropoff_datetime <dttm> 2020-06-14 14:12:58, 2020-06-30 20:04:44, 2020-06-2…
$ passenger_count       <int> 1, 0, 1, 1, 1, 1, 2, 1, 4, 1, 1, 1, 3, 1, 2, 1, 1, 1…
$ trip_distance         <dbl> 1.71, 0.40, 1.82, 3.20, 3.00, 1.97, 1.26, 0.87, 1.20…
$ RatecodeID            <chr> "JFK", "JFK", "Standard Rate", "Standard Rate", "Sta…
$ store_and_fwd_flag    <fct> N, N, N, N, N, N, N, N, N, N, N, N, N, N, N, N, N, N…
$ PULocationID          <int> 140, 140, 140, 249, 43, 42, 236, 239, 100, 74, 186, …
$ DOLocationID          <int> 233, 263, 142, 48, 161, 238, 262, 143, 234, 263, 68,…
$ payment_type          <chr> "Cash", "Cash", "Credit Card", "Credit Card", "Credi…
$ fare_amount           <dbl> 8.0, 3.5, 9.0, 11.0, 11.5, 9.5, 7.5, 6.0, 6.0, 6.5, …
$ extra                 <dbl> 0.0, 3.0, 0.0, 3.5, 0.0, 0.0, 0.0, 0.0, 2.5, 2.5, 0.…
$ mta_tax               <dbl> 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.…
$ tip_amount            <dbl> 0.00, 0.00, 1.50, 3.05, 3.70, 0.00, 0.00, 2.00, 1.00…
$ tolls_amount          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ improvement_surcharge <dbl> 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.…
$ total_amount          <dbl> 11.30, 7.30, 13.80, 18.35, 18.50, 10.30, 10.80, 11.3…
$ congestion_surcharge  <dbl> 2.5, 2.5, 2.5, 2.5, 2.5, 0.0, 2.5, 2.5, 2.5, 2.5, 2.…
$ pickup_day            <fct> 14, 30, 26, 9, 5, 12, 29, 19, 16, 1, 27, 12, 14, 26,…
$ pickup_month          <ord> Jun, Jun, Jun, Jun, Jun, Jun, Jun, Jun, Jun, Jun, Ju…
$ pickup_dayofweek      <ord> Sun, Tue, Fri, Tue, Fri, Fri, Mon, Fri, Tue, Mon, Sa…
$ dropoff_day           <fct> 14, 30, 26, 9, 5, 12, 29, 19, 16, 1, 27, 12, 14, 26,…
$ dropoff_month         <ord> Jun, Jun, Jun, Jun, Jun, Jun, Jun, Jun, Jun, Jun, Ju…
$ dropoff_dayofweek     <ord> Sun, Tue, Fri, Tue, Fri, Fri, Mon, Fri, Tue, Mon, Sa…
$ pickup_hour           <fct> 14, 20, 14, 17, 15, 10, 15, 14, 15, 12, 17, 16, 17, …
$ dropoff_hour          <fct> 14, 20, 14, 17, 15, 10, 15, 14, 15, 12, 17, 16, 18, …
head(june2020)
write.csv(june2020,"nyc_data.csv")

Exploratory Data Analysis

ggplotly(ggplot(data = june2020) + geom_bar(mapping = aes(x= passenger_count, fill=passenger_count)))
ggplotly(ggplot(data = june2020) + 
  geom_bar(mapping = aes(x = VendorID, fill=VendorID)))
ggplotly(ggplot(data = june2020) + 
  geom_bar(mapping = aes(x = payment_type, fill=payment_type)))
ggplotly(ggplot(data = june2020) + 
  geom_bar(mapping = aes(x = RatecodeID, fill=RatecodeID)))
par(mfrow=c(2,2))
ggplotly(ggplot(data = june2020) + geom_bar(mapping = aes(x=pickup_dayofweek, fill=pickup_dayofweek)) + ggtitle("Pick Up Days of the week"))


ggplotly(ggplot(data = june2020) + geom_bar(mapping = aes(x=dropoff_dayofweek, fill=dropoff_dayofweek)) + ggtitle("Drop Off Days of the week"))


ggplotly(ggplot(data = june2020) + geom_bar(mapping = aes(x=pickup_hour, fill=pickup_hour)) + ggtitle("Pick Up Hours of the week"))


ggplotly(ggplot(data = june2020) + geom_bar(mapping = aes(x=dropoff_hour, fill=dropoff_hour)) + ggtitle("Drop Off Hours of the week"))
ggplot(june2020, aes(x = pickup_dayofweek, y = total_amount)) +
  geom_point()

ggplot(june2020, aes(x=trip_distance, y=total_amount))+geom_point()

LS0tCnRpdGxlOiAiTllDIFllbGxvdyBUYXhpIERhdGFzZXQgZm9yIEp1bmUgMjAyMCIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQpgYGB7cn0KbGlicmFyeShwbHlyKQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShsdWJyaWRhdGUpCmxpYnJhcnkocGxvdGx5KQpgYGAKCiMjIyBEYXRhIEV4dHJhY3Rpb24sIFRyYW5zZm9ybWF0aW9uICYgTG9hZGluZwpgYGB7ciBJbXBvcnQgRGF0YXNldH0KI0ltcG9ydCB0aGUgZGF0YXNldCwgcmFuZG9tIHNlbGVjdCA1MCwwMDAgcm93cwpvcmlnaW5hbCA8LSByZWFkLmNzdignaHR0cHM6Ly9zMy5hbWF6b25hd3MuY29tL255Yy10bGMvdHJpcCtkYXRhL3llbGxvd190cmlwZGF0YV8yMDIwLTA2LmNzdicpCmBgYAoKYGBge3J9Cm9yaWdpbmFsPC1kcm9wX25hKG9yaWdpbmFsKQpgYGAKCmBgYHtyfQp1bmlxdWUob3JpZ2luYWwkUmF0ZWNvZGVJRCkKYGBgCgpgYGB7cn0Kb3JpZ2luYWwgPC0gc3Vic2V0LmRhdGEuZnJhbWUob3JpZ2luYWwsIG9yaWdpbmFsJFJhdGVjb2RlSUQgIT0gOTksIGRyb3AgPSBUUlVFKQpgYGAKCmBgYHtyfQpzZXQuc2VlZCgxMDA1MTgyNDMpCmBgYAoKYGBge3J9CmluZGV4IDwtIHNhbXBsZSgxOm5yb3cob3JpZ2luYWwpLDUwMDAwKQpgYGAKCmBgYHtyfQpqdW5lMjAyMCA8LSAob3JpZ2luYWxbaW5kZXgsXSkKYGBgCgoKYGBge3J9CmF0dGFjaChqdW5lMjAyMCkKZGltKGp1bmUyMDIwKQpgYGAKYGBge3J9CnByb2JsZW1zKGp1bmUyMDIwKQpgYGAKVHJhbnNmb3JtIHRoZSBkYXRldGltZSBjb2x1bW5zIGZyb20gY2hhcmFjdGVyIHRvIGRhdGV0aW1lIGRhdGEgdHlwZXMgCmBgYHtyfQpqdW5lMjAyMCR0cGVwX3BpY2t1cF9kYXRldGltZSA8LSB5bWRfaG1zKGp1bmUyMDIwJHRwZXBfcGlja3VwX2RhdGV0aW1lKQpqdW5lMjAyMCR0cGVwX2Ryb3BvZmZfZGF0ZXRpbWUgPC0geW1kX2htcyhqdW5lMjAyMCR0cGVwX2Ryb3BvZmZfZGF0ZXRpbWUpCmBgYAoKQ291bnQgdGhlIG51bWJlciBvZiBudWxsIHZhbHVlIHJvd3MgZm9yIGVhY2ggY29sdW1uCmBgYHtyfQpzYXBwbHkoanVuZTIwMjAsIGZ1bmN0aW9uKHkpIHN1bShsZW5ndGgod2hpY2goaXMubmEoeSkpKSkpCmBgYAoKQ29udmVydCBjb2x1bW5zIHRvIGNhdGVnb3JpY2FsIGZhY3RvcnMKYGBge3J9Cmp1bmUyMDIwJHN0b3JlX2FuZF9md2RfZmxhZyA8LSBwYXJzZV9mYWN0b3IoanVuZTIwMjAkc3RvcmVfYW5kX2Z3ZF9mbGFnKQpqdW5lMjAyMCRwYXltZW50X3R5cGUgPC0gZmFjdG9yKGp1bmUyMDIwJHBheW1lbnRfdHlwZSkKanVuZTIwMjAkVmVuZG9ySUQgPC0gZmFjdG9yKGp1bmUyMDIwJFZlbmRvcklEKQpqdW5lMjAyMCRSYXRlY29kZUlEIDwtIGZhY3RvcihqdW5lMjAyMCRSYXRlY29kZUlEKQpgYGAKCmBgYHtyfQpqdW5lMjAyMCRwYXltZW50X3R5cGUgPC0gbWFwdmFsdWVzKHBheW1lbnRfdHlwZSwgZnJvbSA9IGMoIjEiLCAiMiIsICIzIiwiNCIsIjUiKSwgdG8gPSBjKCJDcmVkaXQgQ2FyZCIsICJDYXNoIiwiTm8gY2hhcmdlIiwiRGlzcHV0ZSIsIlVua25vd24iKSkKYGBgCmBgYHtyfQpqdW5lMjAyMCRWZW5kb3JJRCA8LSBtYXB2YWx1ZXMoVmVuZG9ySUQsIGZyb20gPSBjKCIxIiwgIjIiKSwgdG8gPSBjKCJDcmVhdGl2ZSBNb2JpbGUgVGVjaG5vbG9naWVzIiwgIlZlcmlGb25lIEluYyIpKQpgYGAKCmBgYHtyfQpqdW5lMjAyMCRSYXRlY29kZUlEIDwtIG1hcHZhbHVlcyhwYXltZW50X3R5cGUsIGZyb20gPSBjKCIxIiwgIjIiLCAiMyIsIjQiLCI1IiksIHRvID0gYygiU3RhbmRhcmQgUmF0ZSIsICJKRksiLCJOZXdhcmsiLCJOYXNzYXUgb3IgV2VzdGNoZXN0ZXIiLCJOZWdvdGlhdGVkIGZhcmUiKSkKYGBgCgpgYGB7cn0KanVuZTIwMjAkcGlja3VwX2RheSA8LSBmYWN0b3IoZGF5KHRwZXBfcGlja3VwX2RhdGV0aW1lKSkKanVuZTIwMjAkcGlja3VwX21vbnRoIDwtIGZhY3Rvcihtb250aCh0cGVwX3BpY2t1cF9kYXRldGltZSwgbGFiZWwgPSBUUlVFKSkKanVuZTIwMjAkcGlja3VwX2RheW9md2VlayA8LSBmYWN0b3Iod2RheSh0cGVwX3BpY2t1cF9kYXRldGltZSwgbGFiZWwgPSBUUlVFKSkKCmp1bmUyMDIwJGRyb3BvZmZfZGF5IDwtIGZhY3RvcihkYXkodHBlcF9kcm9wb2ZmX2RhdGV0aW1lKSkKanVuZTIwMjAkZHJvcG9mZl9tb250aCA8LSBmYWN0b3IobW9udGgodHBlcF9kcm9wb2ZmX2RhdGV0aW1lLCBsYWJlbCA9IFRSVUUpKQpqdW5lMjAyMCRkcm9wb2ZmX2RheW9md2VlayA8LSBmYWN0b3Iod2RheSh0cGVwX2Ryb3BvZmZfZGF0ZXRpbWUsIGxhYmVsID0gVFJVRSkpCmBgYAoKYGBge3J9Cmp1bmUyMDIwJHBpY2t1cF9ob3VyIDwtIGZhY3Rvcihob3VyKHRwZXBfcGlja3VwX2RhdGV0aW1lKSkKanVuZTIwMjAkZHJvcG9mZl9ob3VyIDwtIGZhY3Rvcihob3VyKHRwZXBfZHJvcG9mZl9kYXRldGltZSkpCmBgYAoKCmBgYHtyfQpzdHIoanVuZTIwMjApCmBgYAoKCgpgYGB7cn0Kc3VtbWFyeShqdW5lMjAyMCkKYGBgCgpgYGB7cn0KZ2xpbXBzZShqdW5lMjAyMCkKYGBgCgpgYGB7cn0KaGVhZChqdW5lMjAyMCkKYGBgCgpgYGB7ciBTYXZlIHByb2Nlc3NlZCBkYXRhc2V0IHRvIGNzdn0Kd3JpdGUuY3N2KGp1bmUyMDIwLCJueWNfZGF0YS5jc3YiKQpgYGAKCiMjIyBFeHBsb3JhdG9yeSBEYXRhIEFuYWx5c2lzCgpgYGB7cn0KZ2dwbG90bHkoZ2dwbG90KGRhdGEgPSBqdW5lMjAyMCkgKyBnZW9tX2JhcihtYXBwaW5nID0gYWVzKHg9IHBhc3Nlbmdlcl9jb3VudCwgZmlsbD1wYXNzZW5nZXJfY291bnQpKSkKYGBgCmBgYHtyfQpnZ3Bsb3RseShnZ3Bsb3QoZGF0YSA9IGp1bmUyMDIwKSArIAogIGdlb21fYmFyKG1hcHBpbmcgPSBhZXMoeCA9IFZlbmRvcklELCBmaWxsPVZlbmRvcklEKSkpCmBgYApgYGB7cn0KZ2dwbG90bHkoZ2dwbG90KGRhdGEgPSBqdW5lMjAyMCkgKyAKICBnZW9tX2JhcihtYXBwaW5nID0gYWVzKHggPSBwYXltZW50X3R5cGUsIGZpbGw9cGF5bWVudF90eXBlKSkpCmBgYAoKYGBge3J9CmdncGxvdGx5KGdncGxvdChkYXRhID0ganVuZTIwMjApICsgCiAgZ2VvbV9iYXIobWFwcGluZyA9IGFlcyh4ID0gUmF0ZWNvZGVJRCwgZmlsbD1SYXRlY29kZUlEKSkpCmBgYAoKYGBge3J9CnBhcihtZnJvdz1jKDIsMikpCmdncGxvdGx5KGdncGxvdChkYXRhID0ganVuZTIwMjApICsgZ2VvbV9iYXIobWFwcGluZyA9IGFlcyh4PXBpY2t1cF9kYXlvZndlZWssIGZpbGw9cGlja3VwX2RheW9md2VlaykpICsgZ2d0aXRsZSgiUGljayBVcCBEYXlzIG9mIHRoZSB3ZWVrIikpCgpnZ3Bsb3RseShnZ3Bsb3QoZGF0YSA9IGp1bmUyMDIwKSArIGdlb21fYmFyKG1hcHBpbmcgPSBhZXMoeD1kcm9wb2ZmX2RheW9md2VlaywgZmlsbD1kcm9wb2ZmX2RheW9md2VlaykpICsgZ2d0aXRsZSgiRHJvcCBPZmYgRGF5cyBvZiB0aGUgd2VlayIpKQoKZ2dwbG90bHkoZ2dwbG90KGRhdGEgPSBqdW5lMjAyMCkgKyBnZW9tX2JhcihtYXBwaW5nID0gYWVzKHg9cGlja3VwX2hvdXIsIGZpbGw9cGlja3VwX2hvdXIpKSArIGdndGl0bGUoIlBpY2sgVXAgSG91cnMgb2YgdGhlIHdlZWsiKSkKCmdncGxvdGx5KGdncGxvdChkYXRhID0ganVuZTIwMjApICsgZ2VvbV9iYXIobWFwcGluZyA9IGFlcyh4PWRyb3BvZmZfaG91ciwgZmlsbD1kcm9wb2ZmX2hvdXIpKSArIGdndGl0bGUoIkRyb3AgT2ZmIEhvdXJzIG9mIHRoZSB3ZWVrIikpCmBgYAoKYGBge3J9CmdncGxvdChqdW5lMjAyMCwgYWVzKHggPSBwaWNrdXBfZGF5b2Z3ZWVrLCB5ID0gdG90YWxfYW1vdW50KSkgKwogIGdlb21fcG9pbnQoKQpgYGAKCmBgYHtyfQpnZ3Bsb3QoanVuZTIwMjAsIGFlcyh4PXRyaXBfZGlzdGFuY2UsIHk9dG90YWxfYW1vdW50KSkrZ2VvbV9wb2ludCgpCmBgYAoK